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-- file Pass3S.Mesa 

-- last modified by Satterthwaite, July 16, 1978 



10:04 AM 



DIRECTORY 

ComData: FROM "comdata" 
USING [ 

bodylndex, idUNWIND, mainBody, monitored, ownSymbols, seAnon, stopping, 
textlndex, typeBOOLEAN, typeCONDITION, typelNTEGER, typeLOCK], 

ErrorDefs: FROM "errordefs" USING [error, errorsei, errortree], 

LitDefs: FROM "litdefs" 

USING [STIndex, FindStringLiteral , StringLiteralRef erence], 

Pass3: FROM "pass3 M USING [impl icitTree, imp! icitType, lockHeld. lockNode], 

P3Defs: FROM M p3defs" 
USING [ 

Apply, Assignment, BumpCount, BumpFieldRef s , CanonicalType, 
CheckDisjoint, CloseBase, CountTreelds , Declltem, Discrimination, Exp, 
Extract, Identif iedType, Interval, LambdaApply, LongPath, 
MakeFrameRecord, MakePointerType, MatchFields, OpenBase, 
Operandlnternal , OperandLhs, OperandType, OrderedType, PopCtx, 
PopArgCtx, PushArgCtx, PushCtx, RConst, Rhs, RPop, RPush, RType, 
SearchCtxList, TargetType, TypeExp, TypeForTree, VoidExp, 
XferForFrame, XferBody], 

StringDefs: FROM "stringdefs" USING [Substring, SubStringDescriptor] , 

SymDefs: FROM "symdefs" 

USING [setype, ctxtype, mdtype, bodytype, 
ContextLevel , SERecord, 

ISEIndex, CSEIndex, recordCSEIndex, MDIndex, BTIndex, CBTIndex, 
HTNull, SENull, ISENull, CSENull, recordCSENull , BTNull, 
1G, OwnMdi, typeANY], 

SymTabDefs: FROM "symtabdef s" 
USING [ 

EnterString, makenonctxse, NextSe, NormalType, SubStringForHash , 
TransferTypes, TypeRoot, UnderType, XferMode], 

TableDefs: FROM "tabledefs" USING [TableBase, TableNotif ier], 

TreeDefs: FROM "treedefs" 
USING [treetype, 

NodeName, Treelndex, TreeLink, TreeMap, TreeScan, 

empty, nullid, nullTreelndex, 

freenode, freetree, GetNode, makelist, maketree, mlpop, mlpush, 

pushsymtree, pushtree, reversescanl ist, scanlist, setattr, setinfo, 

testtree, updatelist], 

TypePackDefs: FROM "typepackdef s" USING [AssignableTypes]; 

Pass3S: PROGRAM 
IMPORTS 

ErrorDefs, LitDefs, P3Defs, SymTabDefs, TreeDefs, TypePackDefs, 
dataPtr: ComData, passPtr: Pass3 
EXPORTS P3Defs « 
BEGIN 
OPEN SymTabDefs, SymDefs, P3Defs, TreeDefs; 

InsertCatchLabel : SIGNAL [catchSeen: BOOLEAN] - CODE; 



tb: TableDefs. TableBase; 
seb: TableDefs. TableBase; 
ctxb: TableDefs .TableBase; 
mdb: TableDefs. TableBase; 
bb: TableDefs .TableBase; 



-- tree base address (local copy) 
-- se table base address (local copy) 
-- context table base (local copy) 
-- module table base (local copy) 
-- body table base (local copy) 



StmtNotify: PUBLIC TableDefs .TableNotif ier » 

BEGIN -- called by allocator whenever table area is repacked 

tb <- base[treetype]; 

seb <- base[setype] ; ctxb «- base[ctxtype]; mdb +- base[mdtype]; 

bb <- base[bodytype]; RETURN 

END; 



bodies and blocks 



BodyState: TYPE « RECORD[ 
bodyNode: Treelndex, 
impl iedReturn; BOOLEAN, 
inputRecord: recordCSEIndex, 
returnRecord: recordCSEIndex, 
entry: BOOLEAN, 



-- current body 

-- true if return with no args 

-- input record for current body 

-- return record for current body 

-- set for entry procedures 
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labelList: TreeLink, -- list of accessible labels 

loopDepth: CARDINAL, -- depth of loop nesting 

catchDepth: CARDINAL, -- depth of catch phrase nesting 

unwindEnabled: BOOLEAN, -- set iff in scope of unwind 

resumeFlag: BOOLEAN, -- set iff a resume is legal 

resumeRecord: recordCSEIndex]; -- for current catch phrase 

current: BodyState; 

BodyList: PUBLIC PROCEDURE [firstBti: BTIndex] - 
BEGIN 

bti: BTIndex; 

IF (bti <- firstBti) # BTNull 
THEN 
DO 
WITH (bb+bti) SELECT FROM 

Callable «> Body[LOOPHOLE[bti , CBTIndex]]; 
ENDCASE «> NULL; 
IF (bb+bti). link. which ■ parent THEN EXIT; 
bti <- (bb+bti). link. index; 
ENDLOOP; 
RETURN 
END; 

Body: PROCEDURE [bti: CBTIndex] - 
BEGIN 

item: Treelndex; -- item designates a dec! item with body as last son 
saved: BodyState * current; 
savelndex: CARDINAL « dataPtr . textlndex; 
saveBodylndex: CBTIndex « dataPtr .bodylndex; 
saveLockHeld: BOOLEAN « passPtr . lockHeld; 
node: Treelndex; 
lockVar: ISEIndex; 
lockBit: BOOLEAN; 

inRecord, outRecord: recordCSEIndex; 
dataPtr .bodylndex <- bti; 
WITH (bb+bti). info SELECT FROM 
Internal ■> 
BEGIN 

dataPtr .textlndex 4- sourcelndex; 
item <- bodyTree; 

current .bodyNode «- node <- GetNode[(tb+item) .son3]; 
bodyTree «- node; 
END; 
ENDCASE => ERROR; 
current. entry «- (bb+bti) .entry <- (tb+node) .attrl; 
(bb+bti) . internal <- (tb+node) .attr2; 

passPtr. lockHeld <- (bb+bti) .entry OR (bb+bti ). internal ; 
(bb+bti) . ioType <- TypeForTree[(tb+item) . son2] ; 
[inRecord, outRecord] *- TransferTypes[(bb+bti ) . ioType] ; 
PushArgCtx[current . inputRecord «- inRecord]; 
PushArgCtx[current .returnRecord +■ outRecord]; 
-- initialize computed attributes 
current . impl iedReturn <- FALSE; 

current. 1 abelList <- empty; current. loopDepth ♦- 0; 
current. catchDepth <- 0; current .unwindEnabled +- FALSE; 
current. resumeRecord <- recordCSENull ; current. resumeFlag <- FALSE; 
IF current. entry 
THEN 
BEGIN 

IF (lockVar <- FihdLockParams[] .actual ) # SENull 
THEN 
BEGIN 

lockBit <- (seb+lockVar) .writeonce; (seb+lockVar) .writeonce ♦• TRUE; 
END; 
(tb+node) .son4 «- CopyLock[]; 
END; 
BEGIN 
ENABLE 

InsertCatchLabel -> BEGIN ErrorDefs .error[catchLabel] ; RESUME END; 
scan! ist[( tb+node) . sonl, Op en I tern]; 
IF inRecord # SENull THEN 

CheckDisjoint[(seb+ inRecord) . f ieldctx, (bb+bti) . local Ctx]; 
IF outRecord § SENull THEN 
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CheckDisjoint[(seb+outR 
PushCtx[( bb+bti). localCtx 
IF bti - dataPtr. mainBody 
THEN 
BEGIN 

scanl ist[(tb+passPtr . 
PushCtx[(tb+passPtr.l 
(tb+passPtr.lockNode) 
PopCtx[]; 
END; 
scanl is t[ (tb+node) .son 2, 
END; 
(tb+node) . son3 <- updatelist 
I InsertCatchLabel ■> I 
BodyList[(bb+bti).firstSon] 
PopCtx[]; 

reversescanl ist[( tb+node) .s 
(bb+bti) .stopping «- dataPtr 
PopArgCtx[outRecord]; PopA 
(tb+node) .attr2 <- current, i 
IF current. entry AND lockVa 
THEN (seb+lockVar) .writeo 
current «- saved; passPtr.l 
dataPtr.textlndex «- savelnd 
RETURN 
END; 



ecord).fieldctx, (bb+bti) .localCtx]; 

]; 

AND dataPtr .monitored 



lockNode) .sonl, Declltem]; 

ockNode) . info]; 

.son2 4- LockVar[(tb+passPtr. TockNode). son2]; 



Declltem]; 

[(tb+node) ,son3 t Stmt 

F catchSeen THEN RESUME]; 



onl, Closeltem]; 

.stopping AND (bb+bti) . level ■ 1G; 

rgCtx[inRecord]; 

mpl iedReturn; ** find another field 

r # SENull 

nee «- lockBit; 

ockHeld <- saveLockHeld; 

ex; dataPtr. bodylndex <- saveBodylndex; 



Block: PROCEDURE [node: Treelndex] ■ 
BEGIN OPEN (tb+node); 
bti : BTIndex « info; 

savelndex: CARDINAL * dataPtr.textlndex; 
WITH (bb+bti). info SELECT FROM 

Internal «> dataPtr.textlndex <- sourcelndex; 

ENDCASE -> ERROR; 
PushCtx[( bb+bti). localCtx]; 
scanl ist[sonl, Declltem 

1 InsertCatchLabel ■> BEGIN ErrorDef s .error[catchLabel] ; RESUME END]; 
son2 *- update! ist[son2, Stmt]; 
BodyList[(bb+bti).firstSon]; 
PopCtx[]; 

dataPtr.textlndex *- savelndex; RETURN 
END; 



statements 



markCatch: BOOLEAN; 



reset in Stmt, set in CatchPhrase 



saveMark : 
IF stmt a 



the defaults 



RPop[] END; 



Stmt: PROCEDURE [stmt: TreeLink] RETURNS [val : TreeLink] 
BEGIN 

node: Treelndex; 

savelndex: CARDINAL * dataPtr.textlndex; 
BOOLEAN = markCatch; 
empty THEN RETURN [empty]; 
WITH stmt SELECT FROM 
subtree -> 

BEGIN node <- index; 
dataPtr.textlndex «- (tb+node) . info; 
val ♦- stmt; markCatch *- FALSE; 
SELECT (tb+node). name FROM 

assign => BEGIN Assignment[node] ; 
extract ■> Extract[node]; 
apply ■> 
BEGIN 

Apply[node, typeANY, TRUE]; 
IF (tb+node) .name - wait 

THEN ErrorDef s .errortree[typeClash, (tb+node) .sonl]; 
CheckVoid[]; 
END; 
block »> Block[node]; 
ifstmt -> 
BEGIN OPEN (tb+node); 

sonl *- Rhs[sonl, dataPtr . typeBOOLEAN]; RPop[]; 
son2 <- updatelist[son2, Stmt]; 
son3 ♦* update! ist[son3, Stmt]; 
END; 



Pass3S.mesa 2-Sep-78 12:59:59 



casestmt ■> Case[node, Stmt]; 

bindstmt ■> Discrimination[node, Stmt]; 

dostmt ■> DoStmt[node]; 

return ■> Return[node]; 

label ■> 

BEGIN OPEN (tb+node); 
saveList: TreeLink ■ current. labelList; 
InsertLabels[son2]; 
sonl <- update! ist[sonl, Stmt]; 
DeleteLabels[mark: saveList]; 
scanlist[son2, Labelltem]; 
END; 
goto ■> ValidateLabel[(tb+node) .sonl]; 

exit, loop ■> IF current. loopDepth ■ THEN ErrorDef s .error[exit] ; 
signal, error, xerror, start, join, wait «> 
BEGIN 

mlpush[SELECT (tb+node) .name FROM 
start ■> Start[node], 
join «> Join[node], 
wait ■> Wait[node], 
ENDCASE »> Signal[node]]; 
setinfo[dataPtr.textIndex]; val ♦• mlpop[]; 
CheckVoid[]; 
END; 
resume ■> Resume[node]; 

continue, retry a > SIGNAL InsertCatchLabel[catchSeen: FALSE]; 
restart »> val <- FrameXfer[node]; 
stop -> 
BEGIN 

IF dataPtr.bodylndex # dataPtr.mainBody OR current. catchDepth # 
OR current. returnRecord # SENull 

THEN Err or Defs. err or [mi splacedStop]; 
IF (tb+node). sonl § empty THEN [] ♦- CatchPhrase[(tb+node) .sonl]; 
dataPtr .stopping <- TRUE; 
END; 
notify, broadcast a > 
BEGIN OPEN (tb+node); 
type: CSEIndex; 

IF -passPtr.lockHeld THEN ErrorDef s . error[misplacedMoni torRef] ; 
sonl <- Exp[sonl, typeANY]; 

IF ~OperandLhs[sonl] THEN ErrorDef s . errortree[nonLHS, sonl]; 
type «- RType[]; RPop[]; 
IF type # dataPtr.typeCONDITION 

THEN ErrorDefs.errortree[typeClash, sonl]; 
END; 
dst, 1st, lstf -> 

BEGIN OPEN (tb+node); 
v: TreeLink; 

v <- sonl ♦- Exp[sonl, typeANY]; RPop[]; 
DO 

WITH v SELECT FROM 
symbol a > 
BEGIN 
IF (seb+index) .constant OR 

(name « dst AND (seb+index) .writeonce) THEN GO TO fail; 
EXIT 
END; 
subtree *> 
BEGIN 

IF (tb+index).name # dollar THEN GO TO fail; 
v *- (tb+index) .sonl 
END; 
ENDCASE «> GO TO fail; 
REPEAT 

fail *> ErrorDef s .errortree[nonLHS, sonl]; 
ENDLOOP; 
END; 
syserror, nullstmt «> NULL; 
openstmt ■> 

BEGIN OPEN (tb+node); 
scan! ist[sonl , Openltem]; 
son2 <- updatel ist[son2, Stmt]; 
reverses can! ist[sonl , Close I tern]; 
END; 
enable -> 

BEGIN OPEN (tb+node); 
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saveEnabled: BOOLEAN ■ current. unwindEnabled; 
IF CatchPhrase[sonl].unwindCaught 

THEN current. unwindEnabled «- TRUE; 
son2 «- updatelist[son2, Stmt]; 
current. unwindEnabled <- saveEnabled; 
END; 
list ■> val «- updatelist[val , Stmt]; 
ENDCASE »> ErrorDefs.error[unimplemented]; 
END; 
ENDCASE -> ERROR; 
IF markCatch 
THEN 

BEGIN mlpush[val]; pushtree[catchmark,l]; 
setinfo[dataPtr. textlndex]; val «- mlpop[]; 
END; 
markCatch <- saveMark; dataPtr. textlndex <- savelndex; RETURN 
END; 

CheckVoid: PROCEDURE ■ 
BEGIN 
SELECT RType[] FROM 

CSENull, typeANY -> NULL; 
ENDCASE ■> ErrorDefs.error[nonVoidStmt]; 
RPop[]; RETURN 
END; 



-- case statements 

Case: PUBLIC PROCEDURE [node: Treelndex, selection: TreeMap] ■ 
BEGIN OPEN (tb+node); 

saveType: CSEIndex ■ passPtr. imp! icitType; 
saveTree: TreeLink - passPtr. imp! icitTree; 

eqTests: BOOLEAN; 

Caseltem: TreeScan ■ 
BEGIN 

switchable: BOOLEAN; 
savelndex: CARDINAL ■ dataPtr. textlndex; 

CaseTest: TreeMap ■ 
BEGIN 

node: Treelndex ■ GetNode[t]; 
BEGIN OPEN (tb+node); 
SELECT name FROM 
relE »> 
BEGIN 

type: CSEIndex; 

son2 <- Rhs[son2, TargetType[passPtr . impl icitType]]; 
type «- RType[]; 
SELECT (seb+type) . typetag FROM 

long -> BEGIN attrl *- TRUE; attr2 <- FALSE END; 
real a > attrl <- attr2 «- TRUE; 
ENDCASE «> attrl «- attr2 *- FALSE; 
switchable <- switchable AND RConst[]; v «- t; 
END; 
ENDCASE «> 
BEGIN 

v + Rhs[t, dataPtr. typeBOOLEAN]; 
eqTests «- switchable ♦- FALSE; 
END; 
RPop[]; 
END; 
RETURN 
END; 

node: Treelndex ■ GetNode[t]; 
dataPtr. textlndex *- (tb+node) . info; 

BEGIN OPEN (tb+node); 

switchable «- TRUE; 

sonl +■ updatel ist[sonl, CaseTest]; attrl «- switchable; 

son2 *- selection[son2]; 

END; 
dataPtr. textlndex <- savelndex; RETURN 
END; 
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sonl «- Exp[sonl, typeANY]; 

passPtr. implicitType <- CanonicalType[RType[]]; 

RPop[]; 

IF -I dent if iedType[passPtr . implicitType] 

THEN ErrorDefs . errortree[relationType , sonl]; 
passPtr. implicitTree +• sonl; eqTests <- TRUE; 
scanl ist[son2, Caseltem]; attrl <- eqTests; 
son3 <- selection[son3]; 

passPtr. imp! icitType <- saveType; passPtr. implicitTree + saveTree; 
RETURN 
END; 

-- loop statements 

DoStmt: PROCEDURE [node: Treelndex] ■ 
BEGIN OPEN (tb+node); 
forNode: Treelndex; 
cvType: CSEIndex; 
saveList: TreeLink; 
IF sonl # empty 
THEN 

BEGIN forNode <- GetNode[sonl]; 
IF (tb+forNode) .sonl ■ empty 
THEN RPush[typeANY, FALSE] 
ELSE 
BEGIN 

(tb+forNode). sonl <- Exp[(tb+forNode) .sonl, typeANY]; 
IF ~OperandLhs[(tb+forNode) .sonl] 

THEN ErrorDefs. errortree[nonLHS, (tb+forNode) . sonl] ; 
WITH (tb+forNode). sonl SELECT FROM 
symbol ■> 

BEGIN -- account for implicit references 
BumpCount[ index]; BumpCount[ index]; 
END; 
ENDCASE ■> ErrorDefs. errortree[contro!Id, (tb+forNode) . sonl]; 
END; 
cvType <- TargetType[RType[]] ; RPop[]; 
SELECT (tb+forNode). name FROM 
forseq »> 

BEGIN -- sequencing using a generator 
OPEN seq: (tb+forNode); 

seq.son2 <- Rhs[seq. son2, cvType]; RPop[]; 
seq.son3 *- Rhs[seq . son3, cvType]; RPop[]; 
END; 
upthru, downthru «> 

BEGIN -- stepping through an interval 

IF ~OrderedType[cvType] AND cvType # typeANY 

THEN E rrorDefs. err or [nonOrderedType]; 
(tb+forNode) .son2 <- Range[( tb+forNode) .son2, cvType]; 
END; 
ENDCASE »> ERROR; 
END; 
IF son2 # empty 
THEN 

BEGIN son2 «- Rhs[son2, dataPtr. typeBOOLEAN] ; RPop[]; 
END; 
scanl ist[son3, Openltem]; 
current. loopDepth «- current . loopDepth + 1; 
saveList *- current . labelList; InsertLabels[son5]; 
son4 <- updatel ist[son4, Stmt]; 
DeleteLabels[mark: saveList]; 
current . loopDepth «- current . loopDepth - 1; 
IF son5 # empty THEN scanl ist[son5 , Labelltem]; 
son6 <- updatel ist[son6, Stmt]; 
reversescanl ist[son3, Close I tern]; 
RETURN 
END; 

Range: PUBLIC PROCEDURE [t: TreeLink, type: CSEIndex] RETURNS [val: TreeLink] 
BEGIN 

subType: CSEIndex; 
node: Treelndex; 
WITH t SELECT FROM 



Pass3S.mesa 2-Sep-78 12:59:59 Page 



subtree ■> 

BEGIN node <- index; 
SELECT (tb+node).name FROM 
subrangeTC ■> 
BEGIN val «■ t; 

(tb+node) .sonl <- TypeExp[(tb+node) .sonl]; 
subType <- TargetType[ 

UnderType[TypeForTree[(tb+node),sonl]]]; 
Interval[(tb+node) .son2, subType, FALSE]; 
END; 
IN [intOO .. intCC] ■> 
BEGIN val «- t; 

subType <- IF type § typeANY THEN type ELSE dataPtr. typelNTEGER; 
Interva1[t, subType, FALSE]; 
END; 
ENDCASE ■> 

BEGIN val <- TypeExp[t]; 

subType <- TargetType[UnderType[TypeForTree[val]*]]; 
END; 
END; 
ENDCASE ■> 

BEGIN val «- TypeExp[t]; 

subType <- TargetType[UnderType[TypeForTree[val]]]; 
END; 
IF ~OrderedType[subType] AND subType # typeANY 

THEN ErrorDef s . error[nonOrderedType] ; 
IF ~TypePackDefs.AssignableTypes[ 

[dataPtr .ownSymbol s , type], 
[dataPtr .ownSymbols, subType]] 
THEN ErrorDefs.errortree[typeClash, val]; 
RETURN 
END; 



-- labels 

Labelltem: PROCEDURE [item: TreeLink] - 
BEGIN 

node: Treelndex « GetNode[item]; 
(tb+node) .son2 «- update! ist[(tb+node) .son2, Stmt]; 
RETURN 
END; 

InsertLabels: PROCEDURE [t: TreeLink] - 
BEGIN 
labelMark: TreeLink - current. labelList; 

InsertLabel: PROCEDURE [labeled: TreeLink] ■ 
BEGIN 

node: Treelndex s GetNode[l abeled]; 
savelndex: CARDINAL = dataPtr . textlndex; 
dataPtr. textlndex <- (tb+node) . info; 
scan! ist[( tb+node) .sonl, StackLabel]; 
dataPtr. textlndex <- savelndex; RETURN 
END; 

StackLabel: PROCEDURE [id: TreeLink] - 
BEGIN 

t: TreeLink; 
node: Treelndex; 
FOR t <- current. labelList, (tb+node) . son2 UNTIL t a labelMark 

DO 

node «- GetNode[t]; 

IF (tb+node). sonl * id AND id # nullid 

THEN ErrorDef s .errortree[dupl icateLabel , id]; 

ENDLOOP; 
mlpush[id]; ml push[ current. labelList]; 
current. labelList <- maketree[item, 2]; RETURN 
END; 

scanlist[t, InsertLabel]; 

RETURN 

END; 

ValidateLabel : PROCEDURE [id: TreeLink] - , 
BEGIN 
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t: TreeLink; 

node: Treelndex; 

FOR t <- current. labelList, (tb+node) ,son2 UNTIL t ■ empty 

DO 

node <- GetNode[t]; 

IF (tb+node). sonl ■ id THEN RETURN; 

ENDLOOP; 
ErrorDefs.errortree[unknownLabel , id]; 
RETURN 
END; 

DeleteLabels: PROCEDURE [mark: TreeLink] ■ 
BEGIN 

node: Treelndex; 
UNTIL current. labelList ■ mark 

DO 

node ♦- GetNode[current. labelList]; 

current. labelList *- (tb+node) .son2; 

(tb+node) .son2 «- empty; freenode[node]; 

ENDLOOP; 
RETURN 
END; 

-- control transfers 

CheckLocals: PROCEDURE [t: TreeLink] RETURNS [localsOnly: BOOLEAN] - 
BEGIN 
level: ContextLevel ■ (bb+dataPtr .bodylndex) . level ; 

CheckElement: TreeScan ■ 
BEGIN 

sei : ISEIndex; 
WITH t SELECT FROM 
literal «> NULL; 
symbol ■> 

BEGIN sei «- index; 

IF ~(seb+sei) .constant AND (ctxb+(seb+sei) .ctxnum) .ctxlevel # level 

THEN localsOnly <- FALSE; 
END; 
ENDCASE »> localsOnly *- FALSE; 
RETURN 
END; 

localsOnly «- TRUE; scanlist[t t CheckElement]; RETURN 
END; 

Return: PROCEDURE [node: Treelndex] ■ 
BEGIN OPEN (tb+node); 

rSei: recordCSEIndex ■ current. returnRecord; 
IF current .catchDepth # 
OR (dataPtr. bodylndex ■ dataPtr .mainBody AND rSei - SENull) 

THEN ErrorDef s . error[mispl acedReturn]; 
IF (attrl <- current. entry) 

THEN CountTreeIds[(tb+current .bodyNode) .son 4]; 
IF rSei # SENull AND sonl - empty 
THEN 
BEGIN 

attr2 *- TRUE; current, imp! iedReturn «- TRUE; 
IF (seb+(ctxb+(seb+rSei) .fieldctx) .sei ist) .htptr ■ HTNull 

THEN ErrorDef s. err or[ ill DefinedRe turn] ; 
END 
ELSE 
BEGIN 

sonl <- MatchFields[rSei , sonl, FALSE]; 
IF current .entry 

THEN (tb+node). attr2 «- CheckLocals[sonl]; 
END; 
RETURN 
END; 

BodyLiteral: PROCEDURE [bti : CBTIndex] RETURNS [TreeLink] - 
BEGIN 
mdi: MDIndex; 
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sti: LitDefs.STIndex; 

desc: StringDefs.SubStringDescriptor ; 

s: StringDefs. Substring ■ Qdesc; 

mdi <- WITH (ctxb+(bb+bti) .localCtx) SELECT FROM 

included »> ctxmodule, 

ENDCASE -> OwnMdi; 
Substring For Hash[s, (mdb+mdi) .mdhti] ; 

sti <- LitDefs.FindStringLitera"l[s]; LitDef s ,StringLiteralReference[sti]; 
RETURN [[literal[info: [string[index: sti]]]]] 
END; 

New: PUBLIC PROCEDURE [node: Treelndex, target: CSEIndex] RETURNS [val : TreeLink] ■ 
BEGIN 

subNode: Treelndex; 
type, mType, rType: CSEIndex; 
bti: CBTIndex; 

val «- ForceAppl ication[(tb+node) .sonl]; 
(tb+node) .sonl <- empty; f reenode[node]; 
subNode <- GetNode[val]; 
BEGIN OPEN (tb+subNode); 
name <- new; 

sonl <- Exp[sonl, typeANY]; mType <- RType[]; 
RPop[]; 

WITH (seb+mType) SELECT FROM 
transfer ■> 
BEGIN 

IF mode # program THEN ErrorDef s.errortree[typeC1 ash, sonl]; 
type + mType; 

IF (bti «- XferBody[sonl]) # BTNull 
THEN 
BEGIN 

IF (seb+target) . typetag ■ pointer 
THEN type <- 
MakePointerType[MakeFrameRecord[sonl] , target]; 
[] ♦■ f reetree[sonl]; sonl <- BodyLiteral[bti] ; 
attrl <- FALSE; 
END 
ELSE attrl ♦- TRUE; 
END; 
pointer a > 
BEGIN 

type «- mType; dereferenced «- TRUE; rType <- UnderType[pointedtotype]; 
WITH (seb+rType) SELECT FROM 
record ■> 

IF (ctxb+fieldctx).ctxleve1 # 1G 

THEN ErrorDef s.errortree[typeC1ash, sonl] 
ELSE IF (seb+target) .typetag a transfer 
THEN type <- XferForFrame[f ieldctx]; 
ENDCASE -> 

IF pointedtotype # typeANY 

THEN ErrorDefs.errortree[typeC1ash, sonl]; 
attrl «- TRUE; 
END; 
ENDCASE »> 

BEGIN type «- typeANY; 

IF mType # typeANY THEN ErrorDef s .errortree[typeC1 ash, sonl]; 
END; 
IF son2 # empty 
THEN 

BEGIN ErrorDefs.errortree[noApplication, sonl]; 
son2 +■ update1ist[son2, VoidExp]; 
END; 
IF nsons > 2 THEN [] «- CatchPhrase[son3] ; 
RPush[type, FALSE]; 
END; 
RETURN 
END; 

Start: PUBLIC PROCEDURE [node: Treelndex] RETURNS [val: TreeLink] - 
BEGIN 

subNode: Treelndex; 

val «- ForceAppl ication[(tb+node) . sonl] ; 
subNode <~ GetNode[va1]; 
App1y[subNode, typeANY, TRUE]; 
SELECT (tb+subNode). name FROM 
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start, apply ■> NULL; 

ENDCASE ■> ErrorDefs.errortree[typeClash, (tb+subNode) .sonl]; 
(tb+node) .sonl «- empty; f reenode[node]; RETURN 
END; 

FrameXfer: PROCEDURE [node: Treelndex] RETURNS [val : TreeLink] ■ 
BEGIN 

subNode: Treelndex; 
type: CSEIndex; 

val «- ForceApplication[(tb+node) .sonl]; 
subNode «- GetNode[val ] ; 
BEGIN OPEN (tb+subNode); 

name «- (tb+node) .name; info «- (tb+node) . info; 
sonl 4- Exp[sonl, typeANY]; type <- RType[]; 
RPop[]; 

WITH (seb+type) SELECT FROM 
pointer ■> 

-- BEGIN dereferenced «- TRUE; 

-- SELECT (seb+UnderType[pointedtotype]) .typetag FROM 
-- record ■> 

NULL; -- a weak check for now 
-- ENDCASE -> 

-- IF pointedtotype # typeANY 

-- THEN ErrorDef s.errortree[typeClash, sonl]; 
-- END; 
transfer -> 

IF mode # program OR XferBody[sonl] # BTNull 
THEN ErrorDefs.errortree[typeClash, sonl]; 
ENDCASE -> 

IF type # typeANY THEN ErrorDef s .errortree[typeClash , sonl]; 
IF son2 # empty 
THEN 

BEGIN ErrorDef s.errortree[noAppl ication, sonl]; 
son2 <- updatelist[son2, VoidExp]; 
END; 
IF nsons > 2 THEN [] <- CatchPhrase[son3]; 
END; 
(tb+node) .sonl <- empty; f reenode[node]; RETURN 
END; 

Fork: PUBLIC PROCEDURE [node: Treelndex, target: CSEIndex] RETURNS [val: TreeLink] 
BEGIN 

subNode: Treelndex; 
type, subType: CSEIndex; 
val <- ForceApplication[(tb+node) .sonl]; 
(tb+node) .sonl «- empty; f reenode[node]; 
subNode <- GetNode[val]; 
Apply[subNode, typeANY, TRUE]; RPop[]; 
SELECT (tb+subNode). name FROM 
call -> 
BEGIN 
IF passPtr.lockHeld AND Operandlnternal [(tb+subNode) .sonl] 

THEN ErrorDefs.errortree[internalCall , (tb+subNode) .sonl]; 
subType <- OperandType[( tb+subNode) . sonl]; 
WITH procType: (seb+subType) SELECT FROM 
transfer -> 
BEGIN 

type «- makenonctxse[SIZE[transfer constructor SERecord]]; 
(seb+type)t *- SERecord[mark3: TRUE, mark4: TRUE, 
sebody: constructor[transfer[ 
mode: process, 
inrecord: recordCSENull , 
out record : procType.outrecord]]]; 
END; 
ENDCASE -> ERROR; 
(tb+subNode) .name <- fork; 
END; 
apply -> type «- typeANY; 
ENDCASE -> 
BEGIN 

ErrorDefs.errortree[typeClash, (tb+node) .sonl] ; type <- typeANY; 
END; 
(tb+subNode). info *■ type; RPush[type, FALSE]; 
RETURN 
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END; 

Join: PUBLIC PROCEDURE [node: Treelndex] RETURNS [val : TreeLink] ■ 
BEGIN 

subNode: Treelndex; 

val <- ForceApplication[(tb+node) .sonl]; 
subNode + GetNode[val]; 
Apply[subNode, typeANY, TRUE]; 
SELECT (tb+subNode). name FROM 

join ■> NULL; 

apply ■> NULL; 

ENDCASE »> ErrorDefs.errortree[typeClash, (tb+subNode) .sonl]; 
(tb+node) .sonl «- empty; freenode[node]; RETURN 
END; 

Wait: PROCEDURE [node: Treelndex] RETURNS [val: TreeLink] ■ 
BEGIN 

subNode: Treelndex; 

IF ~passPtr .lockHeld THEN ErrorDefs.error[misplacedMonitorRef ]; 
val «- ForceApplication[(tb+node) .sonl]; 
subNode «- GetNode[val]; 
Apply[subNode, typeANY, TRUE]; 
SELECT (tb+subNode). name FROM 

wait ■> NULL; 

apply ■> NULL; 

ENDCASE ■> ErrorDef s.errortree[typeClash, (tb+subNode) .sonl]; 
(tb+node) .sonl <- empty; f reenode[node]; 
IF ~OperandLhs[(tb+subNode) .sonl] 

THEN ErrorDefs.errortree[nonLHS, (tb+subNode) .sonl]; 
[] ♦- freetree[(tb+subNode) ,son2]; 

(tb+subNode) ,son2 <- (tb+subNode) . sonl; (tb+subNode) .sonl <- CopyLock[]; 
RETURN 
END; 

-- monitors 

LockVar: PROCEDURE [t: TreeLink] RETURNS [val: TreeLink] - 
BEGIN 

type, nType: CSEIndex; 
desc: StringDef s.SubStringDescriptor ; 
sei: ISEIndex; 
nDerefs: CARDINAL; 
long, b: BOOLEAN; 

Dereference: PROCEDURE [type: CSEIndex] ■ 
BEGIN 

mlpush[val]; pushtree[uparrow, 1]; setinfo[type]; setattr[l, long]; 
val *- mlpop[]; 
RETURN 
END; 

val <- Exp[t, typeANY]; long «- LongPath[val]; 
type «- RType[]; RPop[]; nDerefs ♦- 0; 
DO 

IF type - dataPtr.typeLOCK 
THEN 
BEGIN 

IF nDerefs # THEN Dereference[type] ; 
GO TO success 
END; 
type «- TypeRoot[type]; nType «- NormalType[type] ; 
WITH (seb+nType) SELECT FROM 
record ■> 
BEGIN 

IF monitored 
THEN 
BEGIN 

desc <- ["LOCK"L, 0, ( n LOCK"L) . length] ; 
[b, sei] <- SearchCtxList[EnterString[6desc], fieldctx]; 
IF ~b THEN ERROR; 
mlpush[val]; pushsymtree[sei]; 

pushtree[IF nDerefs - THEN dollar ELSE dot, 2]; 
setinfo[dataPtr . typeLOCK] ; setattr[l, long]; val «- mlpop[]; 
GO TO success; 
END; 
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GO TO failure; 
END; 
pointer ■> 
BEGIN 

IF (nDerefs <- nDerefs + 1) > 255 THEN GO TO failure; 
IF nDerefs > 1 THEN Dereference[type] ; 
long «- (seb+type). typetag ■ long; 

dereferenced <- TRUE; type <- UnderType[pointedtotype]; 
END; 
ENDCASE ■> GO TO failure; 
REPEAT 

success ■> NULL; 

failure ■> ErrorDefs.errortree[typeClash t val]; 
ENDLOOP; 
IF ~OperandLhs[val] THEN ErrorDef s.errortree[nonLHS, val]; 
RETURN 
END; 

FindLockParams: PROCEDURE RETURNS [formal, actual: ISEIndex] ■ 
BEGIN 

node: Treelndex ■ GetNode[(tb+passPtr, lockNode) .sonl]; 
found: BOOLEAN; 
IF node ■ nullTreelndex 

THEN formal «- actual <- ISENull 
ELSE 
BEGIN 

WITH (tb+node).sonl SELECT FROM 
symbol => formal <- index; 
ENDCASE ■> ERROR; 
IF current. inputRecord - SENull 
THEN found «- FALSE 

ELSE [found, actual] «- SearchCtxList[ 
(seb+formal ) .htptr , 
(seb+current . input Record ).fieldctx]; 
IF -found THEN actual <- ISENull; 
END; 
RETURN 
END; 

CopyLock: PROCEDURE RETURNS [val: TreeLink] - 
BEGIN 

formal, actual: ISEIndex; 
SELECT TRUE FROM 

passPtr. lockNode ■ nullTreelndex ■> 

val «- empty; 
(tb+current.bodyNode) .son4 § empty ■> 

val «- LambdaApply[(tb+current.bodyNode) .son4, ISENull, ISENull]; 
ENDCASE -> 
BEGIN 

[formal :formal , actual : actual ] «- FindLockParams[]; 
IF formal # SENull 
THEN 
BEGIN 

IF actual - SENull 
THEN 
BEGIN 

ErrorDef s ,errorsei[missingLock, formal]; 
actual <- dataPtr .seAnon; 
END; 
IF ~TypePackDef s .AssignableTypes[ 

[dataPtr .ownSymbol s , UnderType[( seb+formal ) . id type]], 
[dataPtr .ownSymbols, UnderType[(seb+actual ) . id type]]] 
THEN ErrorDef s.errortree[typeClash, [symbol[index: actual]]]; 
END; 
val «- LambdaApply[(tb+passPtr . lockNode) .son2, formal, actual]; 
END; 
RETURN 
END; 

-- basing 

Openltem: TreeScan ■ 
BEGIN 

node: Treelndex « GetNode[t]; 
savelndex: CARDINAL ■ dataPtr . textlndex; 
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dataPtr. textlndex «- (tb+node) . info; 
WITH (tb+node). sonl SELECT FROM 
hash ■> 

(tb+node) .son2 «- OpenBase[(tb+node) . son2, index 
1 InsertCatchLabel ■> BEGIN ErrorDef s.error[catchLabel ]; RESUME END]; 
ENDCASE -> ERROR; 
dataPtr. textlndex «- savelndex; RETURN 
END; 

Closeltem: TreeScan ■ 
BEGIN 

node: Treelndex ■ GetNode[t]; 
WITH (tb+node). sonl SELECT FROM 

hash ■> CloseBase[(tb+node) .son2, index]; 

ENDCASE ■> ERROR; 
RETURN 
END; 

-- signals 

Signal: PUBLIC PROCEDURE [node: Treelndex] RETURNS [val: TreeLink] - 
BEGIN 

subNode: Treelndex; 
nodeTag: NodeName ■ (tb+node) .name; 
IF nodeTag a xerror AND current .catchDepth # 

THEN E r ro rDef s. error [mi splacedRe turn]; 
val «- ForceAppl ication[(tb+node) .sonl]; 
subNode «- GetNode[val ]; 
Apply[subNode, typeANY, TRUE]; 
SELECT (tb+subNode).name FROM 
signal -> NULL; 
error ■> 

IF nodeTag # error AND nodeTag # xerror 

THEN ErrorDefs.errortree[typeClash t (tb+subNode) .sonl] ; 
apply «> NULL; 

ENDCASE ■> ErrorDefs.errortree[typeClash, (tb+subNode) .sonl]; 
(tb+subNode) .name «- nodeTag; 
IF nodeTag ■ xerror 
THEN 
BEGIN 

(tb+subNode) .attrl *- current. entry; 
IF current. entry 

THEN (tb+subNode). attr2 ♦■ CheckLocal s[(tb+subNode) .son2]; 
END; 
(tb+node) .sonl <- empty; f reenode[node]; RETURN 
END; 

ForceAppl ication: PROCEDURE [t: TreeLink] RETURNS [TreeLink] ■ 
BEGIN 

IF testtree[t, apply] THEN RETURN [t]; 
mlpush[t]; mlpush[empty]; 
RETURN [maketree[apply, 2]] 
END; 



-- catch phrases 



CatchPhrase: PUBLIC PROCEDURE [t: TreeLink] RETURNS [unwindCaught : BOOLEAN] 
BEGIN 

Catchltem: TreeScan - 
BEGIN 

node: Treelndex « GetNode[t]; 
type: CSEIndex; 
mixed: BOOLEAN; 
savelndex: CARDINAL ■ dataPtr . textlndex; 



CatchLabel: TreeMap ■ 
BEGIN 

subType: CSEIndex; 
v *- Exp[t, typeANY]; 

subType <- CanonicalType[RType[]]; RPop[]; 
SELECT XferMode[subType] FROM 
signal , error »> 
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IF type ■ typeANY 
THEN type ♦■ subType 

ELSE IF type # subType THEN mixed «- TRUE; 
ENDCASE -> 

IF subType # typeANY THEN ErrorDef s . errortree[typeClash, t]; 
RETURN 
END; 

dataPtr.textlndex <- (tb+node) . info; 
type <- typeANY; mixed «- FALSE; 

(tb+node) .sonl *■ update! ist[(tb+node) .sonl, CatchLabel]; 
IF mixed THEN type <~ typeANY; 

(tb+node) .son2 +• CatchBody[(tb+node) ,son2, type]; 
IF (tb+node). sonl ■ TreeLink[symbol[index: dataPtr. idUNWIND]] 
THEN 
BEGIN 

unwindCaught <- TRUE; 

IF current. entry AND -current. unwindEnabled 
AND current. catchDepth ■ 
THEN 
BEGIN 

ml push[( tb+node) . son2]; ml push[CopyLock[]]; 
pushtree[unlock, 1]; setinfo[dataPtr . textlndex]; 
(tb+node) ,son2 <- make! ist[2]; 
END; 
END; 
(tb+node). info «- IF type # typeANY THEN type ELSE SENull; 
dataPtr.textlndex +■ savelndex; RETURN 
END; 

setLabel: BOOLEAN; 
node: Treelndex ■ GetNode[t]; 
setLabel <- unwindCaught <- FALSE; 
BEGIN 

ENABLE InsertCatchLabel -> 
IF ~catchSeen 
THEN 
BEGIN 

setLabel «- TRUE; SIGNAL InsertCatchLabel[catchSeen: TRUE]; RESUME 
END; 
scan! ist[( tb+node) .sonl, Catch I tern]; 
IF (tb+node) .nsons > 1 

THEN (tb+node). son2 <- CatchBody[(tb+node) . son2, typeANY]; 
END; 
IF setLabel THEN markCatch «- TRUE; 
RETURN 
END; 

CatchBody: PROCEDURE [body: TreeLink, type: CSEIndex] RETURNS [val: TreeLink] 
BEGIN 

saveRecord: recordCSEIndex ■ current .resumeRecord; 
saveFlag: BOOLEAN - current . resumeFlag; 
current. catchDepth <- current. catchDepth + 1; 
WITH (seb+type) SELECT FROM 
transfer ■> 

BEGIN current. resumeFlag «- mode ■ signal; 
PushArgCtx[inrecord]; 

PushArgCtx[current .resumeRecord <- outrecord]; 
END; 
ENDCASE -> 

BEGIN current. resumeFlag «- FALSE; 
current. resumeRecord *- recordCSENull ; 
END; 
val <- updatel ist[body, Stmt 

I InsertCatchLabel -> IF catchSeen THEN RESUME]; 
WITH (seb+type) SELECT FROM 
transfer ■> 

BEGIN PopArgCtx[outrecord] ; PopArgCtx[inrecord]; 
END; 
ENDCASE; 
current. catchDepth «- current. catchDepth - 1; 

current. resumeRecord <- saveRecord; current . resumeFlag «- saveFlag; 
RETURN 
END; 
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Resume: PROCEDURE [node: Treelndex] ■ 
BEGIN OPEN (tb+node); 

rSei: recordCSEIndex ■ current. resumeRecord; 
n: CARDINAL; 
se1: ISEIndex; 

IF ~current.resumeFlag THEN ErrorDef s.error[misplacedResume] ; 
IF rSei ■ SENull OR sonl # empty 

THEN sonl ♦- MatchFields[rSei , sonl, FALSE] 
ELSE 

BEGIN n ♦• 0; 
BumpF1eldRefs[rSei]; 

FOR sei <- (ctxb+(seb+rSei).f1eldctx).selist, NextSe[sei] UNTIL se1 ■ SENull 
DO 

n «- n+1; 
IF n-1 AND (seb+sei).htptr ■ HTNull 

THEN ErrorDefs.error[illDef inedReturn]; 
pushsymtree[sei]; 
ENDLOOP; 
sonl <- make! 1st[n]; 
END; 
RETURN 
END; 

END. 



